home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ape-ad1a / cdxvbini.cls < prev    next >
Text File  |  1998-11-07  |  9KB  |  281 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CDXVBINI"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Private Declare Function kpGetProfileInt Lib "kernel32" Alias "GetProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer) As Integer
  11. Private Declare Function kpGetProfileString Lib "kernel32" Alias "GetProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  12. Private Declare Function kpWriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal lpAppName As Any, ByVal lpKeyName As Any, ByVal lpString As Any) As Integer
  13. Private Declare Function kpGetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  14. Private Declare Function kpGetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpAppName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  15. Private Declare Function kpWritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpAppName As Any, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Integer
  16. Private Declare Function kpSendMessage Lib "User32" Alias "SendMessage" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
  17. Private Declare Function kpGetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectory" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  18.  
  19. Public smSectionName As String   'Current section in private Ini file
  20. Public smIniFileName As String   'Fully qualified path/name of current private Ini file
  21. Public nmPrivInit As Integer     'Flag to indicate that Private.Ini is initialized
  22.  
  23. Private Const Max_SectionBuffer = 4096
  24. Private Const Max_EntryBuffer = 255
  25.  
  26. Public Function ExtractName$(sSpecIn$, nBaseOnly%)
  27.   Dim nCnt%, nDot%, sSpecOut$
  28.  
  29.   On Local Error Resume Next
  30.   
  31.   If InStr(sSpecIn, "\") Then
  32.     For nCnt = Len(sSpecIn) To 1 Step -1
  33.       If Mid$(sSpecIn, nCnt, 1) = "\" Then
  34.         sSpecOut = Mid$(sSpecIn, nCnt + 1)
  35.         Exit For
  36.       End If
  37.     Next nCnt
  38.   
  39.   ElseIf InStr(sSpecIn, ":") = 2 Then
  40.     sSpecOut = Mid$(sSpecIn, 3)
  41.     
  42.   Else
  43.     sSpecOut = sSpecIn
  44.   End If
  45.     
  46.   If nBaseOnly Then
  47.     nDot = InStr(sSpecOut, ".")
  48.     If nDot Then
  49.       sSpecOut = Left$(sSpecOut, nDot - 1)
  50.     End If
  51.   End If
  52.  
  53.   ExtractName$ = UCase$(sSpecOut)
  54.  
  55. End Function
  56.  
  57. Public Function ExtractPath$(sSpecIn$)
  58.  
  59.   Dim nCnt%, sSpecOut$
  60.   
  61.   On Local Error Resume Next
  62.  
  63.   If InStr(sSpecIn, "\") Then
  64.     For nCnt = Len(sSpecIn) To 1 Step -1
  65.       If Mid$(sSpecIn, nCnt, 1) = "\" Then
  66.         sSpecOut = Left$(sSpecIn, nCnt)
  67.         Exit For
  68.       End If
  69.     Next nCnt
  70.   
  71.   ElseIf InStr(sSpecIn, ":") = 2 Then
  72.     sSpecOut = CurDir$(sSpecIn)
  73.     If Len(sSpecOut) = 0 Then sSpecOut = CurDir$
  74.  
  75.   Else
  76.     sSpecOut = CurDir$
  77.   End If
  78.     
  79.   If Right$(sSpecOut, 1) <> "\" Then
  80.     sSpecOut = sSpecOut + "\"
  81.   End If
  82.   ExtractPath$ = UCase$(sSpecOut)
  83.  
  84. End Function
  85.  
  86. Public Sub PrivClearEntry(sEntryName As String)
  87.  
  88.   'Bail if not initialized
  89.     If Not nmPrivInit Then
  90.       PrivIniNotReg
  91.       Exit Sub
  92.     End If
  93.  
  94.   'Sets a specific entry in Private.Ini to Nothing or Blank
  95.     Dim nRetVal As Integer
  96.     nRetVal = kpWritePrivateProfileString(smSectionName, sEntryName, "", smIniFileName)
  97.  
  98. End Sub
  99.  
  100. Public Sub PrivDeleteEntry(sEntryName As String)
  101.  
  102.   'Bail if not initialized
  103.     If Not nmPrivInit Then
  104.       PrivIniNotReg
  105.       Exit Sub
  106.     End If
  107.  
  108.   'Deletes a specific entry in Private.Ini
  109.     Dim nRetVal As Integer
  110.     nRetVal = kpWritePrivateProfileString(smSectionName, sEntryName, 0&, smIniFileName)
  111.  
  112. End Sub
  113.  
  114. Public Sub PrivDeleteSection()
  115.  
  116.   'Bail if not initialized
  117.     If Not nmPrivInit Then
  118.       PrivIniNotReg
  119.       Exit Sub
  120.     End If
  121.  
  122.   'Deletes an *entire* [Section] and all its Entries in Private.Ini
  123.     Dim nRetVal As Integer
  124.     nRetVal = kpWritePrivateProfileString(smSectionName, 0&, 0&, smIniFileName)
  125.  
  126.   'Now Private.Ini needs to be reinitialized
  127.     smSectionName = ""
  128.     nmPrivInit = False
  129.  
  130. End Sub
  131.  
  132. Public Function PrivGetInt(sEntryName As String, nDefaultValue As Integer) As Integer
  133.  
  134.   'Bail if not initialized
  135.     If Not nmPrivInit Then
  136.       PrivIniNotReg
  137.       Exit Function
  138.     End If
  139.  
  140.   'Retrieves an Integer value from Private.Ini, range: 0-32767
  141.     PrivGetInt = kpGetPrivateProfileInt(smSectionName, sEntryName, nDefaultValue, smIniFileName)
  142.  
  143. End Function
  144.  
  145. Public Function PrivGetString(sEntryName As String, ByVal sDefaultValue As String) As String
  146.  
  147.   'Bail if not initialized
  148.     If Not nmPrivInit Then
  149.       PrivIniNotReg
  150.       Exit Function
  151.     End If
  152.  
  153.   'Retrieves Specific Entry from Private.Ini
  154.     Dim sTemp As String * Max_EntryBuffer
  155.     Dim nRetVal As Integer
  156.     nRetVal = kpGetPrivateProfileString(smSectionName, sEntryName, sDefaultValue, sTemp, Len(sTemp), smIniFileName)
  157.     If nRetVal Then
  158.       PrivGetString = Left$(sTemp, nRetVal)
  159.     End If
  160.  
  161. End Function
  162.  
  163. Public Function PrivGetTF(sEntryName As String, nDefaultValue As Integer)
  164.   
  165.   'Retrieves Specific Entry as either True/False from Private.Ini
  166.   'local vars
  167.     Dim sTF As String
  168.     Dim sDefault As String
  169.  
  170.   'get string value from INI
  171.     If nDefaultValue Then
  172.       sDefault = "true"
  173.     Else
  174.       sDefault = "false"
  175.     End If
  176.     sTF = PrivGetString(sEntryName, sDefault)
  177.  
  178.   'interpret return string
  179.     Select Case Trim$(UCase$(sTF))
  180.       Case "YES", "Y", "TRUE", "T", "ON", "1", "-1"
  181.         PrivGetTF = True
  182.       Case "NO", "N", "FALSE", "F", "OFF", "0"
  183.         PrivGetTF = False
  184.       Case Else
  185.         PrivGetTF = False
  186.     End Select
  187.  
  188. End Function
  189.  
  190. Private Sub PrivIniNotReg()
  191.   
  192.   'Warn *PROGRAMMER* that there's a logic error!
  193.     MsgBox "[Section] and FileName Not Registered in Private.Ini!", 16, "IniFile Logic Error"
  194.  
  195. End Sub
  196.  
  197. Public Sub PrivIniRead(SectionName$, KeyName$, nDefault%, ByVal DefaultStr$, ReturnStr$, Numeric%, IniFileName$)
  198.  
  199.   'One-shot read from Private.Ini, more *work* than it's worth
  200.     Dim nRetVal As Integer
  201.     Dim RetStr As String * Max_EntryBuffer 'Create an empty string to be filled
  202.  
  203.     If Numeric% Then    'we are looking for integer input
  204.       Numeric% = kpGetPrivateProfileInt(SectionName$, KeyName$, nDefault%, IniFileName$)
  205.     Else
  206.       nRetVal = kpGetPrivateProfileString(SectionName$, KeyName$, DefaultStr$, RetStr$, Len(RetStr$), IniFileName$)
  207.       If nRetVal Then
  208.         ReturnStr$ = Left$(RetStr$, nRetVal)
  209.       End If
  210.     End If
  211.  
  212. End Sub
  213.  
  214. Public Sub Create(sSectionName As String, sIniFileName As String)
  215.  
  216.   'Store module-level values for future reference
  217.     smSectionName = Trim$(sSectionName)
  218.     smIniFileName = Trim$(sIniFileName)
  219.     nmPrivInit = True
  220.  
  221. End Sub
  222.  
  223. Public Sub PrivIniWrite(SectionName$, IniFileName$, EntryName$, ByVal NewVal$)
  224.     
  225.   'One-shot write to Private.Ini, more *work* than it's worth
  226.     Dim nRetVal As Integer
  227.     nRetVal = kpWritePrivateProfileString(SectionName$, EntryName$, NewVal$, IniFileName$)
  228.     
  229. End Sub
  230.  
  231. Public Function PrivPutInt(sEntryName As String, nValue As Integer) As Integer
  232.  
  233.   'Bail if not initialized
  234.     If Not nmPrivInit Then
  235.       PrivIniNotReg
  236.       Exit Function
  237.     End If
  238.  
  239.   'Write an integer to Private.Ini
  240.     PrivPutInt = kpWritePrivateProfileString(smSectionName, sEntryName, Format$(nValue), smIniFileName)
  241.  
  242. End Function
  243.  
  244. Public Function PrivPutString(sEntryName As String, ByVal sValue As String) As Integer
  245.  
  246.   'Bail if not initialized
  247.     If Not nmPrivInit Then
  248.       PrivIniNotReg
  249.       Exit Function
  250.     End If
  251.  
  252.   'Write a string to Private.Ini
  253.     PrivPutString = kpWritePrivateProfileString(smSectionName, sEntryName,